home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Franz PD / Franz PD Disk #167 (1992)(Rhein-Sieg-Soft).zip / Franz PD Disk #167 (1992)(Rhein-Sieg-Soft).adf / Transfer-Form / Transfer-Form < prev    next >
Text File  |  1992-04-03  |  7KB  |  340 lines
  1. REM Programm:  TRANSFER-FORM_V1.1
  2. REM 
  3. REM Zweck   :  Drucken von Überweisungsaufträgen
  4. REM
  5. REM Autor   :  Reik Winkelmann
  6. REM            Dorfstr.4
  7. REM            O-2041 Faulenrost
  8. REM            B.R.D.
  9.  
  10.  
  11. REM ****** bildschirmaufbau ******
  12. SCREEN 1,640,250,4,2
  13. WINDOW 2,"",(0,16)-(631,220),0,1
  14. LIBRARY "graphics.library"
  15. LIBRARY "intuition.library"
  16.  
  17. REM ******bildschirm abschalten ******
  18. POKEW 14676118&,256
  19.  
  20. REM ****** menu abschalten ******
  21. ClearMenuStrip(WINDOW(7))
  22.  
  23. REM ****** Dimensionieren ******
  24. DIM stvor$(9)
  25. DIM bz$(9),ln(9),dt$(9)
  26. DIM inf$(15),inff(15)
  27.  
  28. rp&=WINDOW(8)
  29. leer$=STRING$(70," ")
  30. REM ****** einlesen der data´s
  31. d:
  32. RESTORE
  33. FOR in=0 TO 14 
  34. READ inf$(in),inff(in)
  35. NEXT
  36. FOR u=0 TO 8
  37. READ bz$(u),ln(u)
  38. NEXT
  39.  
  40. REM *******farbeA******
  41. SUB farbeA(co%) STATIC
  42.     SHARED rp&
  43.     CALL SetAPen(rp&,co%)
  44. END SUB
  45. REM ******textausgabe
  46. SUB sprint(text$) STATIC
  47.     SHARED rp&
  48.     CALL text(rp&,SADD(text$),LEN(text$))
  49. END SUB
  50.  
  51. REM ******locate(punkt)
  52. SUB sloc(x%,y%) STATIC
  53.     rp&=WINDOW(8)
  54.     CALL Move&(rp&,x%,y%)
  55. END SUB
  56.  
  57. REM ******rechteck
  58. SUB recht(x1%,y1%,x2%,y2%,co%) STATIC
  59.     SHARED rp&
  60.     CALL SetAPen(rp&,co%)
  61.     CALL rectfill(rp&,x1%,y1%,x2%,y2%)
  62. END SUB
  63.  
  64. REM ******linie
  65. SUB linie(x1%,y1%,x2%,y2%,co%) STATIC
  66.     SHARED rp&
  67.     CALL SetAPen(rp&,co%)
  68.     CALL Move&(rp&,x1%,y1%)
  69.     CALL draw(rp&,x2%,y2%)                         
  70. END SUB
  71.    
  72. REM ******oben
  73. linie 2,1,628,1,2
  74. linie 2,1,2,52,2
  75. linie 2,52,628,52,1
  76. linie 628,52,628,1,1
  77.  
  78. REM ******links
  79. linie 2,55,266,55,2
  80. linie 266,55,266,212,1
  81. linie 266,212,2,212,1
  82. linie 2,212,2,55,2
  83.  
  84. REM ******rechts
  85. linie 272,55,627,55,2
  86. linie 627,55,627,212,1
  87. linie 627,212,272,212,1
  88. linie 272,212,272,55,2
  89.  
  90. REM ****** anzeigen der Bezeichnungen
  91. farbeA 1
  92. FOR u=0 TO 8
  93. x%=16*u+73
  94. sloc 26,x%
  95. sprint(bz$(u))
  96. NEXT
  97.  
  98. REM ****** info oben anzeigen ******
  99. farbeA 3
  100. sloc 17,15
  101. sprint("- T R A N S F E R - F O R M _ V 1.1 -")
  102. farbeA 2
  103. sloc 340,15
  104. sprint("geschrieben von Reik Winkelmann")
  105.        linie 17,26,613,26,2
  106. linie 17,27,613,27,1
  107.  
  108. REM ******info anzeigen
  109. GOSUB info:
  110.  
  111. REM ****** eingabe & pruefen der daten
  112. eingeben:
  113. recht 273,56,626,211,0
  114. CALL SetAPen(rp&,2)
  115. FOR u=0 TO 8
  116. x%=16*u+73
  117. GOSUB tastatur:
  118. stvor$(u)=dt$(u)
  119. NEXT
  120.  
  121. REM ****** druckabfrage ******
  122. in$="Zum Drucken Taste drücken (>ESC< für Abbruch) !"
  123. sloc 30,40:sprint(in$)
  124. loop:
  125. ta$=INKEY$
  126. IF ta$="" THEN loop
  127. IF ta$=CHR$(27) THEN 
  128.     sloc 30,40:sprint(leer$)
  129.     GOTO eingeben
  130. END IF
  131.  
  132. REM ****** drucken *******
  133.   sloc 30,40:sprint(leer$)
  134. in$="Es wird gedruckt !"
  135. sloc 30,40:sprint(in$)
  136. p$=CHR$(27)+"[6w"
  137. eo$=CHR$(27)+"[1w"
  138. do$=CHR$(27)+"[1m"
  139. n$=CHR$(27)+"[2"+CHR$(34)+"z"
  140. FOR t=0 TO 2:LPRINT " ":NEXT
  141. LPRINT p$+eo$+do$+n$+"  ";dt$(0):LPRINT " "
  142. LPRINT p$+eo$+do$+n$+"  ";dt$(1)+STRING$(19-LEN(dt$(1))," ")+dt$(2):LPRINT " "
  143. LPRINT p$+eo$+do$+"  ";dt$(3):LPRINT " "
  144. LPRINT p$+eo$+do$+"  ";STRING$(15," ");dt$(4):LPRINT " "
  145. LPRINT p$+eo$+do$+"  ";dt$(5):LPRINT " "
  146. LPRINT p$+eo$+do$+"  ";dt$(6):LPRINT " "
  147. LPRINT p$+eo$+do$+"  ";dt$(7):LPRINT " "
  148. LPRINT p$+eo$+do$+"  ";dt$(8);STRING$(11-LEN(dt$(8))," ");dt$(4)
  149. sloc 30,40:sprint(leer$)
  150. GOTO eingeben:
  151.  
  152. lo:
  153. IF INKEY$="" THEN lo:
  154. RETURN
  155.  
  156. REM - - - ende des programms - - -
  157.  
  158. ende:
  159. sloc 30,40 
  160. in$="Programm wirklich beenden ?"
  161. sprint(in$)
  162.  
  163. REM ****** ja-feld aufbauen ******
  164.  
  165. linie 300,31,380,31,2
  166. linie 300,31,300,45,2 
  167. linie 300,45,380,45,1
  168. linie 380,31,380,45,1 
  169. farbeA 1
  170. sloc 330,41
  171. sprint("Ja")
  172.  
  173. REM ******nein-feld aufbauen ******
  174.  
  175. linie 420,31,500,31,2
  176. linie 420,31,420,45,2 
  177. linie 420,45,500,45,1
  178. linie 500,31,500,45,1 
  179. farbeA 1
  180. sloc 444,41
  181. sprint("Nein")
  182.  
  183. REM ****** schalter ******
  184. WHILE MOUSE(0)<>0:WEND
  185. schalende:
  186. IF MOUSE(0)=0 THEN schalende
  187. xm=MOUSE(1)
  188. ym=MOUSE(2)
  189. IF xm<380 AND xm>300 AND ym<45 AND ym>31 THEN GOTO jaum 
  190. IF xm<500 AND xm>420 AND ym<45 AND ym>31 THEN GOTO neinum 
  191. GOTO schalende
  192.  
  193. neinum: 
  194. linie 420,31,500,31,1
  195. linie 420,31,420,45,1 
  196. linie 420,45,500,45,2
  197. linie 500,31,500,45,2 
  198. recht 30,30,501,45,0
  199. GOTO eingeben
  200.  
  201. REM ****** beenden des programmes
  202. jaum:
  203. linie 300,31,380,31,1
  204. linie 300,31,300,45,1 
  205. linie 300,45,380,45,2
  206. linie 380,31,380,45,2 
  207. LIBRARY CLOSE
  208. MENU RESET
  209. WINDOW CLOSE 2
  210. WINDOW OUTPUT 1 
  211. SCREEN CLOSE 1
  212. END
  213. REM - - - data´s - - -
  214.  
  215. DATA "T R A N S F E R _ F O R M   V 1.1",2
  216. DATA " ",0
  217. DATA "Geschrieben 1991-1992",1
  218. DATA " ",0
  219. DATA "Tips, Hinweise, Kritik, Verbesserungs-",1
  220. DATA "vorschläge, Spenden und a.S.o.ä. bitte",1
  221. DATA "an folgende Adresse schicken:",1
  222. DATA " ",0 
  223. DATA "           Reik Winkelmann",2
  224. DATA "           Dorfstraße 4",2
  225. DATA " ",0
  226. DATA "           O-2041 Faulenrost",2
  227. DATA " ",0
  228. DATA "Für nähere Informationen, bitte ich ",1
  229. DATA "Dich, das DOC-File zu lesen.",1
  230.  ",1
  231. DATA "Empfänger                  :",27       
  232. DATA "Kontonummer des Empfängers :",10
  233. DATA "Bankleitzahl               :",8
  234. DATA "Kreditinstitut             :",27
  235. DATA "Betrag                     :",12
  236. DATA "Verwendungszweck           :",27
  237. DATA "noch   -''-                :",27
  238. DATA "Auftraggeber               :",27
  239. DATA "Kontonummer des  -''-      :",10
  240.  
  241. REM - - - fehler1: eingabe zu lang - - -
  242.  
  243. RETURN
  244.  
  245. REM - - - info - - - 
  246.  
  247. info:
  248. rp&=WINDOW(8)
  249. FOR in=0 TO 14
  250. y%=8*in+73
  251. sloc 290,y%
  252. far%=inff(in)
  253. CALL SetAPen(rp&,far%)
  254. sprint(inf$(in))
  255. NEXT
  256. linie 571,192,616,192,2
  257. linie 571,206,616,206,1
  258. linie 571,192,571,206,2
  259. linie 616,192,616,206,1
  260. sloc 578,202
  261. CALL SetAPen(rp&,2)
  262. sprint("O.K.")
  263.  
  264. REM ******bildschirm einschalten ******
  265. POKEW 14676118&,33024&
  266. schalter:
  267. IF MOUSE(0)=0 THEN schalter
  268. xm=MOUSE(1)
  269. ym=MOUSE(2)
  270. IF xm<616 AND xm>571 AND ym<206 AND ym>192 THEN umschalten ELSE GOTO schalter
  271.  
  272. umschalten:
  273. linie 571,192,616,192,1
  274. linie 571,206,616,206,2
  275. linie 571,192,571,206,1
  276. linie 616,192,616,206,2
  277. RETURN
  278.  
  279. REM ******eingabe
  280. tastatur:
  281. FOR i=0 TO 20
  282. d$=INKEY$
  283. NEXT
  284.  
  285. start:
  286. st$=""
  287. sloc 280,x%: sprint(STRING$(35," "))
  288. sloc 300,x%: sprint("_")
  289.  
  290. marke:
  291. a$=""
  292. a$=INKEY$
  293. IF a$="" THEN marke
  294. le=LEN(st$)
  295.  
  296. IF le=0 AND ASC(a$)=8 THEN 
  297.   SOUND 1500,.25
  298.   GOTO marke:
  299. END IF
  300.  
  301. IF le>(ln(u)-1) AND a$<>CHR$(8) AND a$<>CHR$(27) AND a$<>CHR$(127) AND a$<>CHR$(138) AND a$<>CHR$(13) THEN
  302.   SOUND 1500,.25
  303.   GOTO marke:
  304. END IF
  305.   
  306. IF a$=CHR$(8) THEN 
  307.   st$=LEFT$(st$,le-1)
  308.   sloc 300,x%: sprint(st$+"_")+STRING$(29-LEN(st$)," ")
  309.    GOTO marke:
  310. END IF
  311.  
  312. IF a$=CHR$(13) THEN
  313.   SOUND 1500,.25  
  314.   dt$(u)=st$
  315.   RETURN
  316. END IF
  317.  
  318. REM ****** programm beenden ******
  319. IF a$=CHR$(27) THEN GOTO ende:
  320.  
  321. REM * * * string aus speicher hohlen * * *
  322. IF a$=CHR$(138) THEN 
  323.   st$=stvor$(u)
  324.   sloc 300,x%:sprint(STRING$(35," "))
  325.   a$=""
  326. END IF
  327.  
  328. REM * * * alles löschen * * *
  329. IF a$=CHR$(127) THEN 
  330.   st$=""
  331.   sloc 300,x%:sprint(STRING$(35," "))
  332.   a$=""
  333. END IF
  334.  
  335. st$=st$+a$
  336. sloc 300,x%:sprint(st$+"_")
  337.  
  338. GOTO marke
  339.  
  340.